Celestin Apprentice 7

home *** CD-ROM | disk | FTP | other *** search

/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / IO Examples / Worm / worm.icl next >

Wrap

Text File | 1997-05-01 | 11.7 KB | 338 lines | [TEXT/3PRM]

module worm /* The famous Unix game 'worm' (or 'snake') in Concurrent Clean. This program requires the 0.8 I/O library. Run the program using the "No Console" option (Application options). */ import StdBool, StdChar, StdString, StdFile, StdArray, StdList, StdTuple, StdEnum import deltaDialog, deltaEventIO, deltaWindow, deltaMenu, deltaTimer, deltaSystem import wormshow, wormstate, Help // GUI constants. FileID :== 1 PlayID :== 11 InterruptID :== 12 HaltID :== 121 ContID :== 122 QuitID :== 13 LevelID :== 2 EasyID :== 21 MediumID :== 22 HardID :== 23 HiScoreID :== 24 HighDlogID :== 1000 OverDlogID :== 2000 WindowID :== 1 WdPicSize :== ((0,0),(488,303)) TimerID :== 1 HelpFile :== "WormHelp" HiScoresFile :== "wormhi" NrOfHiScores :== 8 // Start of the program. Start :: *World -> *World Start world # (events,world) = OpenEvents world (files, world) = openfiles world (about,files) = MakeAboutDialog "Worm" HelpFile files Help (hifile,best) = ReadHiScores HiScoresFile files (state,events) = StartIO [DialogSystem [about], menu, window, timer] (InitState best) init_io events files = WriteHiScores hifile state.best world = closefiles files world world = CloseEvents events world = world where init_io = [ initFoodSupply , initWindowPicture ] initFoodSupply state=:{worm,level} io # (seed,io) = GetNewRandomSeed io foods = FoodSupply seed (food,foods) = NewFood worm level foods = ({state & food=food,foodsupply=foods}, io) initWindowPicture state io = (state, DrawInWindow WindowID [SetBackColour WormBackGroundColour,SetFontSize WormFontSize] io) menu = MenuSystem [ PullDownMenu FileID "File" Able [ MenuItem PlayID "Play" (Key 'R') Able Play , MenuItemGroup InterruptID [MenuItem HaltID "Halt" (Key '.') Unable Halt] , MenuSeparator , MenuItem QuitID "Quit" (Key 'Q') Able Quit ] , PullDownMenu LevelID "Options" Able [ MenuRadioItems EasyID [ MenuRadioItem EasyID "Slow" (Key '1') Able (SetSpeed EasySpeed) , MenuRadioItem MediumID "Medium" (Key '2') Able (SetSpeed MediumSpeed) , MenuRadioItem HardID "Fast" (Key '3') Able (SetSpeed HardSpeed) ] , MenuSeparator , MenuItem HiScoreID "High Scores" (Key 'H') Able ShowBest ] ] window = WindowSystem [ FixedWindow WindowID (0,0) "Worm" WdPicSize UpdateWindow [ GoAway Quit , Keyboard Unable MakeTurn ] ] timer = TimerSystem [ Timer TimerID Unable EasySpeed OneStep ] // The update function for the playfield window. UpdateWindow :: UpdateArea State -> (State, [DrawFunction]) UpdateWindow _ state=:{level,food,points,worm,lives} = (state, DrawGame level food points worm lives) // The function for the Help button of the about dialog Help :: State (IOState State) -> (State, IOState State) Help state=:{best=(files,hs)} io # (files,io) = ShowHelp HelpFile files io = ({state & best=(files,hs)}, io) // The function for the Play command. Play :: State (IOState State) -> (State, IOState State) Play state=:{level={fix,speed},foodsupply} io # io = ActivateWindow WindowID io io = DisableMenus [LevelID] io io = DisableMenuItems [PlayID,QuitID] io io = EnableMenuItems [HaltID] io io = SetTimerInterval TimerID speed io io = EnableKeyboard WindowID io io = EnableTimer TimerID io io = DrawInWindow WindowID (DrawGame initlevel newfood initpoints initworm initlives) io io = ChangeWindowCursor WindowID HiddenCursor io = (initstate, io) where initlevel = InitLevel fix initworm = NewWorm initlevel (newfood,foods1)= NewFood initworm initlevel foodsupply initpoints = 0 initlives = NrOfWorms initstate = {state & level = initlevel , food = newfood , foodsupply = foods1 , grow = 0 , points = initpoints , dir = RightKey , worm = initworm , lives = initlives } // The functions for the Halt/Continue command(s). Halt :: State (IOState State) -> (State, IOState State) Halt state io # io = DisableKeyboard WindowID io io = DisableTimer TimerID io io = EnableMenuItems [QuitID] io io = RemoveMenuItems [HaltID] io io = InsertMenuItems InterruptID 1 [continue] io io = ChangeWindowCursor WindowID StandardCursor io = (state, io) where continue = MenuItem ContID "Continue" (Key '.') Able Continue Continue :: State (IOState State) -> (State, IOState State) Continue state io # io = ActivateWindow WindowID io io = DisableMenuItems [QuitID] io io = RemoveMenuItems [ContID] io io = InsertMenuItems InterruptID 1 [halt] io io = EnableKeyboard WindowID io io = EnableTimer TimerID io io = ChangeWindowCursor WindowID HiddenCursor io = (state, io) where halt = MenuItem HaltID "Halt" (Key '.') Able Halt // The function for the Quit command: stop the program. Quit :: State (IOState State) -> (State, IOState State) Quit state io = (state, QuitIO io) // Set a new speed (called when one of the Options commands is chosen). SetSpeed :: Int State (IOState State) -> (State, IOState State) SetSpeed fix state=:{State | level} io = ({State | state & level={level & fix=fix,speed=fix}}, io) // Show the high scores. ShowBest :: State (IOState State) -> (State, IOState State) ShowBest state=:{best=(_,highs)} io = ShowHiScores HighDlogID "Worm High Scores:" highs state io // The MakeTurn function is called when a key is pressed. MakeTurn :: KeyboardState State (IOState State) -> (State, IOState State) MakeTurn (key,KeyDown,_) state=:{dir} io | (dir==UpKey || dir==DownKey) && (key==LeftKey || key==RightKey) = OneStep 1 {state & dir=key} io | (dir==LeftKey || dir==RightKey) && (key==UpKey || key==DownKey ) = OneStep 1 {state & dir=key} io | otherwise = (state,io) MakeTurn _ state io = (state,io) // The function for the Timer device: do one step of the worm game. OneStep :: TimerState State (IOState State) -> (State, IOState State) OneStep _ state=:{level,food,foodsupply,grow,points,dir,worm,best,lives} io | newlevel<>curlevel = SwitchLevel level foodsupply points2 points best lives io # state = {state & food=food1,foodsupply=foods1,grow=grow1,points=points2,worm=worm1} | collide = NextLife state io # io = DrawInWindow WindowID [DrawStep scored food food1 points2 (hd worm) head tail] io | scored = (state,Beep io) | otherwise = (state,io) where (head,tail,worm1) = StepWorm dir grow worm scored = head==food.pos collide = Collision level worm head value = food.value (food1,foods1) = if scored (NewFood worm1 level foodsupply) (food,foodsupply) grow1 = if scored (grow+value*3/2) (max 0 (grow-1)) points1 = if scored (points+value*(length worm1)/2) points points2 = if collide (max 0 (points1-100)) points1 curlevel = points /PointsPerLevel newlevel = points2/PointsPerLevel Collision :: Level Worm Segment -> Bool Collision level worm head | not (InRectangle head ((1,1),(SizeX,SizeY))) = True | any (InRectangle head) level.obstacles = True | otherwise = isMember head worm where InRectangle :: Point Obstacle -> Bool InRectangle (x,y) ((lx,ty),(rx,by)) = x>=lx && x<=rx && y>=ty && y<=by StepWorm :: Direction Grow Worm -> (Segment,Segment,Worm) StepWorm dir 0 worm = (head,tail,[head:worm1]) where (tail,worm1)= GetAndRemoveLast worm head = NewHead dir (hd worm) GetAndRemoveLast :: ![.x] -> (.x,![.x]) GetAndRemoveLast [x] = (x,[]) GetAndRemoveLast [x:xs] = (x1,[x:xs1]) where (x1,xs1) = GetAndRemoveLast xs StepWorm dir _ worm = (head,(0,0),[head:worm]) where head = NewHead dir (hd worm) NewHead :: Direction Segment -> Segment NewHead UpKey (x,y) = (x, y-1) NewHead DownKey (x,y) = (x, y+1) NewHead LeftKey (x,y) = (x-1,y) NewHead RightKey (x,y) = (x+1,y) SwitchLevel :: Level [Food] Points Points HiScores Lives (IOState State) -> (State,IOState State) SwitchLevel curlevel foods newPoints oldPoints high lives io = (newstate,NextLevelAnimation io) where newlevel = if (newPoints>oldPoints) (IncreaseLevel curlevel) (DecreaseLevel curlevel) initworm = NewWorm newlevel (newfood,foods1)= NewFood initworm newlevel foods newstate = { level = newlevel , food = newfood , foodsupply = foods1 , grow = 0 , points = newPoints , dir = RightKey , worm = initworm , best = high , lives = if (newPoints>oldPoints) (lives+1) (lives-1) } NextLevelAnimation :: (IOState State) -> IOState State NextLevelAnimation io # io = ChangeTimerFunction TimerID (BetweenLevels nrAnimationSteps (-1)) io io = SetTimerInterval TimerID (TicksPerSecond/30) io io = DisableActiveKeyboard io = io where nrAnimationSteps= 40 BetweenLevels :: Int Int TimerState State (IOState State) -> (State, IOState State) BetweenLevels animationStep step _ state=:{level,food,points,worm,lives} io | animationStep<=1 = (state, ChangeTimerFunction TimerID (BetweenLevels 2 1) io) | animationStep<=nrAnimationSteps = (state, io2) with io1 = DrawInActiveWindow [DrawAnimation animationStep step] io io2 = ChangeTimerFunction TimerID (BetweenLevels (animationStep+step) step) io1 # io = DrawInWindow WindowID (DrawGame level food points worm lives) io io = SetTimerInterval TimerID level.speed io io = ChangeTimerFunction TimerID OneStep io io = EnableActiveKeyboard io = (state,io) NextLife :: State (IOState State) -> (State, IOState State) NextLife state=:{level,foodsupply,points,best=(_,highs),worm,lives} io | lives>0 = ({state & food=newfood,foodsupply=foods1,grow=0,dir=RightKey,worm=newworm,lives=lives-1},DeadWormAlert worm io) with (newfood,foods1)= NewFood newworm level foodsupply newworm = NewWorm level DeadWormAlert :: Worm (IOState State) -> IOState State DeadWormAlert worm io # io = ChangeTimerFunction TimerID (DeadWorm worm) io io = SetTimerInterval TimerID (TicksPerSecond/30) io io = DisableActiveKeyboard io = io where DeadWorm :: Worm TimerState State (IOState State) -> (State, IOState State) DeadWorm [segment:rest] _ state io # io = DrawInWindow WindowID [EraseSegment segment] io = (state, ChangeTimerFunction TimerID (DeadWorm rest) io) DeadWorm _ _ state=:{level,food,points,worm,lives} io # io = DrawInWindow WindowID (DrawGame level food points worm lives) io io = ChangeTimerFunction TimerID OneStep io io = SetTimerInterval TimerID level.speed io io = EnableActiveKeyboard io = (state, io) # io = EnableMenus [LevelID] io io = EnableMenuItems [PlayID,QuitID] io io = DisableMenuItems [HaltID] io io = DisableTimer TimerID io io = DisableKeyboard WindowID io io = ChangeWindowCursor WindowID StandardCursor io | ItsAHighScore NrOfHiScores points highs = OpenModalDialog dialog state io with dialog = CommandDialog OverDlogID "Game Over" [ ItemSpace (MM 6.0) (MM 6.0) ] 4 [ StaticText 1 Left "Game Over with a new high score!" , StaticText 2 Left "Your name:" , EditText 3 (RightTo 2) (MM 45.0) 1 "" , DialogButton 4 Center "OK" Able OverOK ] OverOK :: DialogInfo State (IOState State) -> (State, IOState State) OverOK dialog state=:{points,best=(files,highs)} io # io = CloseActiveDialog io | name=="" = (state, io) # highs = AddScore NrOfHiScores {name=name,score=points} highs state = {state & best=(files,highs)} | otherwise = (state, io) where name = GetEditText 3 dialog # (_,state,io) = OpenNotice (Notice ["Game Over, no high score."] (NoticeButton 1 "OK") []) state io | otherwise = (state,io)